home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / lisp / qui_aux.el < prev    next >
Encoding:
Text File  |  1992-05-26  |  4.0 KB  |  131 lines
  1. ; /ports/emacs/GNU/el3.1 @(#)qui_aux.el    1.1 11/15/90 
  2. ;;;  /ports/home/sitaram/Gnu/qui_emacs/qui_aux.el @(#)qui_aux.el    1.2 11/13/90 
  3. ;;;            Quintus Prolog - GNU Emacs Interface
  4. ;;;                         Support Functions
  5. ;;;
  6. ;;;                Consolidated by Sitaram Muralidhar
  7. ;;;
  8. ;;;                   sitaram@quintus.com
  9. ;;;              Quintus Computer Systems, Inc.
  10. ;;;                  2 May 1989       
  11. ;;;
  12. ;;; This file defines functions that support the Quintus Prolog - GNU Emacs
  13. ;;; interface.
  14. ;;;
  15. ;;;                   Acknowledgements
  16. ;;;
  17. ;;; This interface was made possible by contributions from Fernando
  18. ;;; Pereira and various customers of Quintus Computer Systems, Inc.,
  19. ;;; based on code for Quintus's Unipress Emacs interface.
  20. ;;; 
  21.  
  22. ;----------------------------------------------------------------------------
  23. ; The following routines are used to properly handle message display
  24. ;  for the routines which talk to the Emacs interface from Prolog
  25.  
  26. (defvar *qpmess-buffer* " ")
  27.  
  28. (defun &qp-message (message)
  29.   (setq *qpmess-buffer* message)
  30.     )
  31.  
  32. (defun display-any-messages ()
  33.   (if (not (string-equal *qpmess-buffer* ""))
  34.       (message *qpmess-buffer*)
  35.     )
  36.   (sit-for 0)
  37.   (&clear-message)
  38.   )
  39.  
  40. (defun &clear-message ()
  41.     (setq *qpmess-buffer* "")
  42.     )
  43.  
  44. (defun &no-message ()
  45.   (setq *qpmess-buffer* "")
  46.   )
  47.  
  48. (defmacro first-line ()
  49.   (save-excursion (beginning-of-line) (bobp)))
  50.  
  51. (defmacro last-line ()
  52.   (save-excursion (end-of-line) (eobp)))
  53.  
  54. (defun skip-prolog-comment (range)
  55.   (let ((current-location (point)))
  56.   (if (save-excursion 
  57.     (beginning-of-line)
  58.     (search-forward "%" current-location t))
  59.       (progn (skip-prolog-%-comment range) t)
  60.     (not (skip-prolog-/*-*/-comment range)))))
  61.  
  62. (defun skip-prolog-%-comment (range)
  63.   "Skip to the beginning or end of a prolog comment depending
  64. on if the range is before or after the point in"
  65.   (let* ((forward (> (point) range))
  66.      (line-skip (if forward -1 1))
  67.      (in-comment t))
  68.     (while (and in-comment (not (bobp)) (not (eobp)))
  69.       (previous-line line-skip)
  70.       (beginning-of-line)
  71.       (setq in-comment (= (following-char) ?%)))))
  72.  
  73. (defun skip-prolog-/*-*/-comment (range)
  74. "Skip to the beginning or end of a prolog comment depending
  75. on if the range is before or after the point in"
  76.   (let* ((current-point (point))
  77.          (forward (> current-point range)))
  78.       (if forward
  79.       (if (save-excursion (search-backward "\/*" range t))
  80.           (not (search-forward "*\/"))
  81.         t)
  82.     (if (save-excursion (search-forward "*\/" range t))
  83.         (not (search-backward "\/*"))
  84.       t))))
  85.  
  86.  
  87. (defun beginning-of-clause (&optional arg)
  88.   "Move backward to next beginning-of-clause.
  89. With argument, do this that many times.
  90. Returns t unless search stops due to end of buffer."
  91.   (interactive "p")
  92.   (and arg (< arg 0) (forward-char 1))
  93.   (let ((clause-point (point)) (not-done t) (command-point (point)))
  94.     (while (and not-done (not (bobp)) (not (eobp)))
  95.       (if (and arg (< arg 0))
  96.       (skip-chars-forward " \t\n")
  97.       (skip-chars-backward " \t\n"))
  98.       (if (re-search-backward "^\\S-" nil 'move (or arg 1))
  99.       (if (= (following-char) ?%)
  100.           (skip-prolog-%-comment clause-point)
  101.         (setq not-done (not (skip-prolog-/*-*/-comment clause-point)))))
  102.       (setq clause-point (point)))
  103.     )
  104.   )
  105.  
  106. (defun end-of-clause (&optional arg)
  107.   "Move forward to next end of prolog clause.
  108. An end of a defun is found by moving forward from the beginning of one."
  109.   (interactive "p")
  110.   (and arg (< arg 0) (forward-char 1))
  111.   (let ((clause-point (point)) (not-done t) (command-point (point)))
  112.     (while (and not-done (not (bobp)) (not (eobp)))
  113.       (re-search-forward "[^.]\\.\\(\\s-\\)*$" nil 'move (or arg 1))
  114.       (setq not-done (skip-prolog-comment clause-point))
  115.       (setq clause-point (point)))
  116.     (if not-done (progn (goto-char command-point) (beep)))))
  117.  
  118. (defun mark-clause ()
  119.   (interactive)
  120.   (end-of-clause)
  121.   (set-mark (point))
  122.   (beginning-of-clause)
  123.   (message "Clause marked")
  124. )
  125.  
  126. (defun kill-clause ()
  127. "Kill the prolog clause that the point in currently in"
  128.   (interactive)
  129.   (mark-clause)
  130.   (kill-region (point) (mark)))
  131.